home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / djgpp / src / gdb-4.12 / gdb / m2-exp.y < prev    next >
Encoding:
GNU Bison Grammar  |  1994-02-03  |  26.5 KB  |  1,163 lines
  1. /* YACC grammar for Modula-2 expressions, for GDB.
  2.    Copyright (C) 1986, 1989, 1990, 1991 Free Software Foundation, Inc.
  3.    Generated from expread.y (now c-exp.y) and contributed by the Department
  4.    of Computer Science at the State University of New York at Buffalo, 1991.
  5.  
  6. This file is part of GDB.
  7.  
  8. This program is free software; you can redistribute it and/or modify
  9. it under the terms of the GNU General Public License as published by
  10. the Free Software Foundation; either version 2 of the License, or
  11. (at your option) any later version.
  12.  
  13. This program is distributed in the hope that it will be useful,
  14. but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. GNU General Public License for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with this program; if not, write to the Free Software
  20. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  21.  
  22. /* Parse a Modula-2 expression from text in a string,
  23.    and return the result as a  struct expression  pointer.
  24.    That structure contains arithmetic operations in reverse polish,
  25.    with constants represented by operations that are followed by special data.
  26.    See expression.h for the details of the format.
  27.    What is important here is that it can be built up sequentially
  28.    during the process of parsing; the lower levels of the tree always
  29.    come first in the result.
  30.  
  31.    Note that malloc's and realloc's in this file are transformed to
  32.    xmalloc and xrealloc respectively by the same sed command in the
  33.    makefile that remaps any other malloc/realloc inserted by the parser
  34.    generator.  Doing this with #defines and trying to control the interaction
  35.    with include files (<malloc.h> and <stdlib.h> for example) just became
  36.    too messy, particularly when such includes can be inserted at random
  37.    times by the parser generator. */
  38.    
  39. %{
  40.  
  41. #include "defs.h"
  42. #include "expression.h"
  43. #include "language.h"
  44. #include "value.h"
  45. #include "parser-defs.h"
  46. #include "m2-lang.h"
  47. #include "bfd.h" /* Required by objfiles.h.  */
  48. #include "symfile.h" /* Required by objfiles.h.  */
  49. #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
  50.  
  51. /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
  52.    as well as gratuitiously global symbol names, so we can have multiple
  53.    yacc generated parsers in gdb.  Note that these are only the variables
  54.    produced by yacc.  If other parser generators (bison, byacc, etc) produce
  55.    additional global names that conflict at link time, then those parser
  56.    generators need to be fixed instead of adding those names to this list. */
  57.  
  58. #define    yymaxdepth m2_maxdepth
  59. #define    yyparse    m2_parse
  60. #define    yylex    m2_lex
  61. #define    yyerror    m2_error
  62. #define    yylval    m2_lval
  63. #define    yychar    m2_char
  64. #define    yydebug    m2_debug
  65. #define    yypact    m2_pact
  66. #define    yyr1    m2_r1
  67. #define    yyr2    m2_r2
  68. #define    yydef    m2_def
  69. #define    yychk    m2_chk
  70. #define    yypgo    m2_pgo
  71. #define    yyact    m2_act
  72. #define    yyexca    m2_exca
  73. #define    yyerrflag m2_errflag
  74. #define    yynerrs    m2_nerrs
  75. #define    yyps    m2_ps
  76. #define    yypv    m2_pv
  77. #define    yys    m2_s
  78. #define    yy_yys    m2_yys
  79. #define    yystate    m2_state
  80. #define    yytmp    m2_tmp
  81. #define    yyv    m2_v
  82. #define    yy_yyv    m2_yyv
  83. #define    yyval    m2_val
  84. #define    yylloc    m2_lloc
  85. #define    yyreds    m2_reds        /* With YYDEBUG defined */
  86. #define    yytoks    m2_toks        /* With YYDEBUG defined */
  87.  
  88. #ifndef YYDEBUG
  89. #define    YYDEBUG    0        /* Default to no yydebug support */
  90. #endif
  91.  
  92. int
  93. yyparse PARAMS ((void));
  94.  
  95. static int
  96. yylex PARAMS ((void));
  97.  
  98. void
  99. yyerror PARAMS ((char *));
  100.  
  101. #if 0
  102. static char *
  103. make_qualname PARAMS ((char *, char *));
  104. #endif
  105.  
  106. static int
  107. parse_number PARAMS ((int));
  108.  
  109. /* The sign of the number being parsed. */
  110. static int number_sign = 1;
  111.  
  112. /* The block that the module specified by the qualifer on an identifer is
  113.    contained in, */
  114. #if 0
  115. static struct block *modblock=0;
  116. #endif
  117.  
  118. %}
  119.  
  120. /* Although the yacc "value" of an expression is not used,
  121.    since the result is stored in the structure being created,
  122.    other node types do have values.  */
  123.  
  124. %union
  125.   {
  126.     LONGEST lval;
  127.     unsigned LONGEST ulval;
  128.     double dval;
  129.     struct symbol *sym;
  130.     struct type *tval;
  131.     struct stoken sval;
  132.     int voidval;
  133.     struct block *bval;
  134.     enum exp_opcode opcode;
  135.     struct internalvar *ivar;
  136.  
  137.     struct type **tvec;
  138.     int *ivec;
  139.   }
  140.  
  141. %type <voidval> exp type_exp start set
  142. %type <voidval> variable
  143. %type <tval> type
  144. %type <bval> block 
  145. %type <sym> fblock 
  146.  
  147. %token <lval> INT HEX ERROR
  148. %token <ulval> UINT M2_TRUE M2_FALSE CHAR
  149. %token <dval> FLOAT
  150.  
  151. /* Both NAME and TYPENAME tokens represent symbols in the input,
  152.    and both convey their data as strings.
  153.    But a TYPENAME is a string that happens to be defined as a typedef
  154.    or builtin type name (such as int or char)
  155.    and a NAME is any other symbol.
  156.  
  157.    Contexts where this distinction is not important can use the
  158.    nonterminal "name", which matches either NAME or TYPENAME.  */
  159.  
  160. %token <sval> STRING
  161. %token <sval> NAME BLOCKNAME IDENT VARNAME
  162. %token <sval> TYPENAME
  163.  
  164. %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
  165. %token INC DEC INCL EXCL
  166.  
  167. /* The GDB scope operator */
  168. %token COLONCOLON
  169.  
  170. %token <lval> LAST REGNAME
  171.  
  172. %token <ivar> INTERNAL_VAR
  173.  
  174. /* M2 tokens */
  175. %left ','
  176. %left ABOVE_COMMA
  177. %nonassoc ASSIGN
  178. %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
  179. %left OROR
  180. %left LOGICAL_AND '&'
  181. %left '@'
  182. %left '+' '-'
  183. %left '*' '/' DIV MOD
  184. %right UNARY
  185. %right '^' DOT '[' '('
  186. %right NOT '~'
  187. %left COLONCOLON QID
  188. /* This is not an actual token ; it is used for precedence. 
  189. %right QID
  190. */
  191.  
  192.  
  193. %%
  194.  
  195. start   :    exp
  196.     |    type_exp
  197.     ;
  198.  
  199. type_exp:    type
  200.         { write_exp_elt_opcode(OP_TYPE);
  201.           write_exp_elt_type($1);
  202.           write_exp_elt_opcode(OP_TYPE);
  203.         }
  204.     ;
  205.  
  206. /* Expressions */
  207.  
  208. exp     :       exp '^'   %prec UNARY
  209.                         { write_exp_elt_opcode (UNOP_IND); }
  210.  
  211. exp    :    '-'
  212.             { number_sign = -1; }
  213.         exp    %prec UNARY
  214.             { number_sign = 1;
  215.               write_exp_elt_opcode (UNOP_NEG); }
  216.     ;
  217.  
  218. exp    :    '+' exp    %prec UNARY
  219.         { write_exp_elt_opcode(UNOP_PLUS); }
  220.     ;
  221.  
  222. exp    :    not_exp exp %prec UNARY
  223.             { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
  224.     ;
  225.  
  226. not_exp    :    NOT
  227.     |    '~'
  228.     ;
  229.  
  230. exp    :    CAP '(' exp ')'
  231.             { write_exp_elt_opcode (UNOP_CAP); }
  232.     ;
  233.  
  234. exp    :    ORD '(' exp ')'
  235.             { write_exp_elt_opcode (UNOP_ORD); }
  236.     ;
  237.  
  238. exp    :    ABS '(' exp ')'
  239.             { write_exp_elt_opcode (UNOP_ABS); }
  240.     ;
  241.  
  242. exp    :     HIGH '(' exp ')'
  243.             { write_exp_elt_opcode (UNOP_HIGH); }
  244.     ;
  245.  
  246. exp     :    MIN_FUNC '(' type ')'
  247.             { write_exp_elt_opcode (UNOP_MIN);
  248.               write_exp_elt_type ($3);
  249.               write_exp_elt_opcode (UNOP_MIN); }
  250.     ;
  251.  
  252. exp    :     MAX_FUNC '(' type ')'
  253.             { write_exp_elt_opcode (UNOP_MAX);
  254.               write_exp_elt_type ($3);
  255.               write_exp_elt_opcode (UNOP_MIN); }
  256.     ;
  257.  
  258. exp    :    FLOAT_FUNC '(' exp ')'
  259.             { write_exp_elt_opcode (UNOP_FLOAT); }
  260.     ;
  261.  
  262. exp    :    VAL '(' type ',' exp ')'
  263.             { write_exp_elt_opcode (BINOP_VAL);
  264.               write_exp_elt_type ($3);
  265.               write_exp_elt_opcode (BINOP_VAL); }
  266.     ;
  267.  
  268. exp    :    CHR '(' exp ')'
  269.             { write_exp_elt_opcode (UNOP_CHR); }
  270.     ;
  271.  
  272. exp    :    ODD '(' exp ')'
  273.             { write_exp_elt_opcode (UNOP_ODD); }
  274.     ;
  275.  
  276. exp    :    TRUNC '(' exp ')'
  277.             { write_exp_elt_opcode (UNOP_TRUNC); }
  278.     ;
  279.  
  280. exp    :    SIZE exp       %prec UNARY
  281.             { write_exp_elt_opcode (UNOP_SIZEOF); }
  282.     ;
  283.  
  284.  
  285. exp    :    INC '(' exp ')'
  286.             { write_exp_elt_opcode(UNOP_PREINCREMENT); }
  287.     ;
  288.  
  289. exp    :    INC '(' exp ',' exp ')'
  290.             { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
  291.               write_exp_elt_opcode(BINOP_ADD);
  292.               write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
  293.     ;
  294.  
  295. exp    :    DEC '(' exp ')'
  296.             { write_exp_elt_opcode(UNOP_PREDECREMENT);}
  297.     ;
  298.  
  299. exp    :    DEC '(' exp ',' exp ')'
  300.             { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
  301.               write_exp_elt_opcode(BINOP_SUB);
  302.               write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
  303.     ;
  304.  
  305. exp    :    exp DOT NAME
  306.             { write_exp_elt_opcode (STRUCTOP_STRUCT);
  307.               write_exp_string ($3);
  308.               write_exp_elt_opcode (STRUCTOP_STRUCT); }
  309.     ;
  310.  
  311. exp    :    set
  312.     ;
  313.  
  314. exp    :    exp IN set
  315.             { error("Sets are not implemented.");}
  316.     ;
  317.  
  318. exp    :    INCL '(' exp ',' exp ')'
  319.             { error("Sets are not implemented.");}
  320.     ;
  321.  
  322. exp    :    EXCL '(' exp ',' exp ')'
  323.             { error("Sets are not implemented.");}
  324.  
  325. set    :    '{' arglist '}'
  326.             { error("Sets are not implemented.");}
  327.     |    type '{' arglist '}'
  328.             { error("Sets are not implemented.");}
  329.     ;
  330.  
  331.  
  332. /* Modula-2 array subscript notation [a,b,c...] */
  333. exp     :       exp '['
  334.                         /* This function just saves the number of arguments
  335.                that follow in the list.  It is *not* specific to
  336.                function types */
  337.                         { start_arglist(); }
  338.                 non_empty_arglist ']'  %prec DOT
  339.                         { write_exp_elt_opcode (MULTI_SUBSCRIPT);
  340.               write_exp_elt_longcst ((LONGEST) end_arglist());
  341.               write_exp_elt_opcode (MULTI_SUBSCRIPT); }
  342.         ;
  343.  
  344. exp    :    exp '('
  345.             /* This is to save the value of arglist_len
  346.                being accumulated by an outer function call.  */
  347.             { start_arglist (); }
  348.         arglist ')'    %prec DOT
  349.             { write_exp_elt_opcode (OP_FUNCALL);
  350.               write_exp_elt_longcst ((LONGEST) end_arglist ());
  351.               write_exp_elt_opcode (OP_FUNCALL); }
  352.     ;
  353.  
  354. arglist    :
  355.     ;
  356.  
  357. arglist    :    exp
  358.             { arglist_len = 1; }
  359.     ;
  360.  
  361. arglist    :    arglist ',' exp   %prec ABOVE_COMMA
  362.             { arglist_len++; }
  363.     ;
  364.  
  365. non_empty_arglist
  366.         :       exp
  367.                         { arglist_len = 1; }
  368.     ;
  369.  
  370. non_empty_arglist
  371.         :       non_empty_arglist ',' exp %prec ABOVE_COMMA
  372.                             { arglist_len++; }
  373.          ;
  374.  
  375. /* GDB construct */
  376. exp    :    '{' type '}' exp  %prec UNARY
  377.             { write_exp_elt_opcode (UNOP_MEMVAL);
  378.               write_exp_elt_type ($2);
  379.               write_exp_elt_opcode (UNOP_MEMVAL); }
  380.     ;
  381.  
  382. exp     :       type '(' exp ')' %prec UNARY
  383.                         { write_exp_elt_opcode (UNOP_CAST);
  384.               write_exp_elt_type ($1);
  385.               write_exp_elt_opcode (UNOP_CAST); }
  386.     ;
  387.  
  388. exp    :    '(' exp ')'
  389.             { }
  390.     ;
  391.  
  392. /* Binary operators in order of decreasing precedence.  Note that some
  393.    of these operators are overloaded!  (ie. sets) */
  394.  
  395. /* GDB construct */
  396. exp    :    exp '@' exp
  397.             { write_exp_elt_opcode (BINOP_REPEAT); }
  398.     ;
  399.  
  400. exp    :    exp '*' exp
  401.             { write_exp_elt_opcode (BINOP_MUL); }
  402.     ;
  403.  
  404. exp    :    exp '/' exp
  405.             { write_exp_elt_opcode (BINOP_DIV); }
  406.     ;
  407.  
  408. exp     :       exp DIV exp
  409.                         { write_exp_elt_opcode (BINOP_INTDIV); }
  410.         ;
  411.  
  412. exp    :    exp MOD exp
  413.             { write_exp_elt_opcode (BINOP_REM); }
  414.     ;
  415.  
  416. exp    :    exp '+' exp
  417.             { write_exp_elt_opcode (BINOP_ADD); }
  418.     ;
  419.  
  420. exp    :    exp '-' exp
  421.             { write_exp_elt_opcode (BINOP_SUB); }
  422.     ;
  423.  
  424. exp    :    exp '=' exp
  425.             { write_exp_elt_opcode (BINOP_EQUAL); }
  426.     ;
  427.  
  428. exp    :    exp NOTEQUAL exp
  429.             { write_exp_elt_opcode (BINOP_NOTEQUAL); }
  430.         |       exp '#' exp
  431.                         { write_exp_elt_opcode (BINOP_NOTEQUAL); }
  432.     ;
  433.  
  434. exp    :    exp LEQ exp
  435.             { write_exp_elt_opcode (BINOP_LEQ); }
  436.     ;
  437.  
  438. exp    :    exp GEQ exp
  439.             { write_exp_elt_opcode (BINOP_GEQ); }
  440.     ;
  441.  
  442. exp    :    exp '<' exp
  443.             { write_exp_elt_opcode (BINOP_LESS); }
  444.     ;
  445.  
  446. exp    :    exp '>' exp
  447.             { write_exp_elt_opcode (BINOP_GTR); }
  448.     ;
  449.  
  450. exp    :    exp LOGICAL_AND exp
  451.             { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
  452.     ;
  453.  
  454. exp    :    exp OROR exp
  455.             { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
  456.     ;
  457.  
  458. exp    :    exp ASSIGN exp
  459.             { write_exp_elt_opcode (BINOP_ASSIGN); }
  460.     ;
  461.  
  462.  
  463. /* Constants */
  464.  
  465. exp    :    M2_TRUE
  466.             { write_exp_elt_opcode (OP_BOOL);
  467.               write_exp_elt_longcst ((LONGEST) $1);
  468.               write_exp_elt_opcode (OP_BOOL); }
  469.     ;
  470.  
  471. exp    :    M2_FALSE
  472.             { write_exp_elt_opcode (OP_BOOL);
  473.               write_exp_elt_longcst ((LONGEST) $1);
  474.               write_exp_elt_opcode (OP_BOOL); }
  475.     ;
  476.  
  477. exp    :    INT
  478.             { write_exp_elt_opcode (OP_LONG);
  479.               write_exp_elt_type (builtin_type_m2_int);
  480.               write_exp_elt_longcst ((LONGEST) $1);
  481.               write_exp_elt_opcode (OP_LONG); }
  482.     ;
  483.  
  484. exp    :    UINT
  485.             {
  486.               write_exp_elt_opcode (OP_LONG);
  487.               write_exp_elt_type (builtin_type_m2_card);
  488.               write_exp_elt_longcst ((LONGEST) $1);
  489.               write_exp_elt_opcode (OP_LONG);
  490.             }
  491.     ;
  492.  
  493. exp    :    CHAR
  494.             { write_exp_elt_opcode (OP_LONG);
  495.               write_exp_elt_type (builtin_type_m2_char);
  496.               write_exp_elt_longcst ((LONGEST) $1);
  497.               write_exp_elt_opcode (OP_LONG); }
  498.     ;
  499.  
  500.  
  501. exp    :    FLOAT
  502.             { write_exp_elt_opcode (OP_DOUBLE);
  503.               write_exp_elt_type (builtin_type_m2_real);
  504.               write_exp_elt_dblcst ($1);
  505.               write_exp_elt_opcode (OP_DOUBLE); }
  506.     ;
  507.  
  508. exp    :    variable
  509.     ;
  510.  
  511. /* The GDB internal variable $$, et al. */
  512. exp    :    LAST
  513.             { write_exp_elt_opcode (OP_LAST);
  514.               write_exp_elt_longcst ((LONGEST) $1);
  515.               write_exp_elt_opcode (OP_LAST); }
  516.     ;
  517.  
  518. exp    :    REGNAME
  519.             { write_exp_elt_opcode (OP_REGISTER);
  520.               write_exp_elt_longcst ((LONGEST) $1);
  521.               write_exp_elt_opcode (OP_REGISTER); }
  522.     ;
  523.  
  524. exp    :    SIZE '(' type ')'    %prec UNARY
  525.             { write_exp_elt_opcode (OP_LONG);
  526.               write_exp_elt_type (builtin_type_int);
  527.               write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
  528.               write_exp_elt_opcode (OP_LONG); }
  529.     ;
  530.  
  531. exp    :    STRING
  532.             { write_exp_elt_opcode (OP_M2_STRING);
  533.               write_exp_string ($1);
  534.               write_exp_elt_opcode (OP_M2_STRING); }
  535.     ;
  536.  
  537. /* This will be used for extensions later.  Like adding modules. */
  538. block    :    fblock    
  539.             { $$ = SYMBOL_BLOCK_VALUE($1); }
  540.     ;
  541.  
  542. fblock    :    BLOCKNAME
  543.             { struct symbol *sym
  544.                 = lookup_symbol (copy_name ($1), expression_context_block,
  545.                          VAR_NAMESPACE, 0, NULL);
  546.               $$ = sym;}
  547.     ;
  548.                  
  549.  
  550. /* GDB scope operator */
  551. fblock    :    block COLONCOLON BLOCKNAME
  552.             { struct symbol *tem
  553.                 = lookup_symbol (copy_name ($3), $1,
  554.                          VAR_NAMESPACE, 0, NULL);
  555.               if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
  556.                 error ("No function \"%s\" in specified context.",
  557.                    copy_name ($3));
  558.               $$ = tem;
  559.             }
  560.     ;
  561.  
  562. /* Useful for assigning to PROCEDURE variables */
  563. variable:    fblock
  564.             { write_exp_elt_opcode(OP_VAR_VALUE);
  565.               write_exp_elt_block (NULL);
  566.               write_exp_elt_sym ($1);
  567.               write_exp_elt_opcode (OP_VAR_VALUE); }
  568.     ;
  569.  
  570. /* GDB internal ($foo) variable */
  571. variable:    INTERNAL_VAR
  572.             { write_exp_elt_opcode (OP_INTERNALVAR);
  573.               write_exp_elt_intern ($1);
  574.               write_exp_elt_opcode (OP_INTERNALVAR); }
  575.     ;
  576.  
  577. /* GDB scope operator */
  578. variable:    block COLONCOLON NAME
  579.             { struct symbol *sym;
  580.               sym = lookup_symbol (copy_name ($3), $1,
  581.                            VAR_NAMESPACE, 0, NULL);
  582.               if (sym == 0)
  583.                 error ("No symbol \"%s\" in specified context.",
  584.                    copy_name ($3));
  585.  
  586.               write_exp_elt_opcode (OP_VAR_VALUE);
  587.               /* block_found is set by lookup_symbol.  */
  588.               write_exp_elt_block (block_found);
  589.               write_exp_elt_sym (sym);
  590.               write_exp_elt_opcode (OP_VAR_VALUE); }
  591.     ;
  592.  
  593. /* Base case for variables. */
  594. variable:    NAME
  595.             { struct symbol *sym;
  596.               int is_a_field_of_this;
  597.  
  598.                sym = lookup_symbol (copy_name ($1),
  599.                            expression_context_block,
  600.                            VAR_NAMESPACE,
  601.                            &is_a_field_of_this,
  602.                            NULL);
  603.               if (sym)
  604.                 {
  605.                   if (symbol_read_needs_frame (sym))
  606.                 {
  607.                   if (innermost_block == 0 ||
  608.                       contained_in (block_found, 
  609.                             innermost_block))
  610.                     innermost_block = block_found;
  611.                 }
  612.  
  613.                   write_exp_elt_opcode (OP_VAR_VALUE);
  614.                   /* We want to use the selected frame, not
  615.                  another more inner frame which happens to
  616.                  be in the same block.  */
  617.                   write_exp_elt_block (NULL);
  618.                   write_exp_elt_sym (sym);
  619.                   write_exp_elt_opcode (OP_VAR_VALUE);
  620.                 }
  621.               else
  622.                 {
  623.                   struct minimal_symbol *msymbol;
  624.                   register char *arg = copy_name ($1);
  625.  
  626.                   msymbol = lookup_minimal_symbol (arg, NULL);
  627.                   if (msymbol != NULL)
  628.                 {
  629.                   write_exp_msymbol
  630.                     (msymbol,
  631.                      lookup_function_type (builtin_type_int),
  632.                      builtin_type_int);
  633.                 }
  634.                   else if (!have_full_symbols () && !have_partial_symbols ())
  635.                 error ("No symbol table is loaded.  Use the \"symbol-file\" command.");
  636.                   else
  637.                 error ("No symbol \"%s\" in current context.",
  638.                        copy_name ($1));
  639.                 }
  640.             }
  641.     ;
  642.  
  643. type
  644.     :    TYPENAME
  645.             { $$ = lookup_typename (copy_name ($1),
  646.                         expression_context_block, 0); }
  647.  
  648.     ;
  649.  
  650. %%
  651.  
  652. #if 0  /* FIXME! */
  653. int
  654. overflow(a,b)
  655.    long a,b;
  656. {
  657.    return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
  658. }
  659.  
  660. int
  661. uoverflow(a,b)
  662.    unsigned long a,b;
  663. {
  664.    return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
  665. }
  666. #endif /* FIXME */
  667.  
  668. /* Take care of parsing a number (anything that starts with a digit).
  669.    Set yylval and return the token type; update lexptr.
  670.    LEN is the number of characters in it.  */
  671.  
  672. /*** Needs some error checking for the float case ***/
  673.  
  674. static int
  675. parse_number (olen)
  676.      int olen;
  677. {
  678.   register char *p = lexptr;
  679.   register LONGEST n = 0;
  680.   register LONGEST prevn = 0;
  681.   register int c,i,ischar=0;
  682.   register int base = input_radix;
  683.   register int len = olen;
  684.   int unsigned_p = number_sign == 1 ? 1 : 0;
  685.  
  686.   if(p[len-1] == 'H')
  687.   {
  688.      base = 16;
  689.      len--;
  690.   }
  691.   else if(p[len-1] == 'C' || p[len-1] == 'B')
  692.   {
  693.      base = 8;
  694.      ischar = p[len-1] == 'C';
  695.      len--;
  696.   }
  697.  
  698.   /* Scan the number */
  699.   for (c = 0; c < len; c++)
  700.   {
  701.     if (p[c] == '.' && base == 10)
  702.       {
  703.     /* It's a float since it contains a point.  */
  704.     yylval.dval = atof (p);
  705.     lexptr += len;
  706.     return FLOAT;
  707.       }
  708.     if (p[c] == '.' && base != 10)
  709.        error("Floating point numbers must be base 10.");
  710.     if (base == 10 && (p[c] < '0' || p[c] > '9'))
  711.        error("Invalid digit \'%c\' in number.",p[c]);
  712.  }
  713.  
  714.   while (len-- > 0)
  715.     {
  716.       c = *p++;
  717.       n *= base;
  718.       if( base == 8 && (c == '8' || c == '9'))
  719.      error("Invalid digit \'%c\' in octal number.",c);
  720.       if (c >= '0' && c <= '9')
  721.     i = c - '0';
  722.       else
  723.     {
  724.       if (base == 16 && c >= 'A' && c <= 'F')
  725.         i = c - 'A' + 10;
  726.       else
  727.          return ERROR;
  728.     }
  729.       n+=i;
  730.       if(i >= base)
  731.      return ERROR;
  732.       if(!unsigned_p && number_sign == 1 && (prevn >= n))
  733.      unsigned_p=1;        /* Try something unsigned */
  734.       /* Don't do the range check if n==i and i==0, since that special
  735.      case will give an overflow error. */
  736.       if(RANGE_CHECK && n!=i && i)
  737.       {
  738.      if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
  739.         ((!unsigned_p && number_sign==-1) && -prevn <= -n))
  740.         range_error("Overflow on numeric constant.");
  741.       }
  742.      prevn=n;
  743.     }
  744.  
  745.   lexptr = p;
  746.   if(*p == 'B' || *p == 'C' || *p == 'H')
  747.      lexptr++;            /* Advance past B,C or H */
  748.  
  749.   if (ischar)
  750.   {
  751.      yylval.ulval = n;
  752.      return CHAR;
  753.   }
  754.   else if ( unsigned_p && number_sign == 1)
  755.   {
  756.      yylval.ulval = n;
  757.      return UINT;
  758.   }
  759.   else if((unsigned_p && (n<0))) {
  760.      range_error("Overflow on numeric constant -- number too large.");
  761.      /* But, this can return if range_check == range_warn.  */
  762.   }
  763.   yylval.lval = n;
  764.   return INT;
  765. }
  766.  
  767.  
  768. /* Some tokens */
  769.  
  770. static struct
  771. {
  772.    char name[2];
  773.    int token;
  774. } tokentab2[] =
  775. {
  776.     { {'<', '>'},    NOTEQUAL     },
  777.     { {':', '='},    ASSIGN    },
  778.     { {'<', '='},    LEQ    },
  779.     { {'>', '='},    GEQ    },
  780.     { {':', ':'},    COLONCOLON },
  781.  
  782. };
  783.  
  784. /* Some specific keywords */
  785.  
  786. struct keyword {
  787.    char keyw[10];
  788.    int token;
  789. };
  790.  
  791. static struct keyword keytab[] =
  792. {
  793.     {"OR" ,   OROR     },
  794.     {"IN",    IN         },/* Note space after IN */
  795.     {"AND",   LOGICAL_AND},
  796.     {"ABS",   ABS     },
  797.     {"CHR",   CHR     },
  798.     {"DEC",   DEC     },
  799.     {"NOT",   NOT     },
  800.     {"DIV",   DIV         },
  801.     {"INC",   INC     },
  802.     {"MAX",   MAX_FUNC     },
  803.     {"MIN",   MIN_FUNC     },
  804.     {"MOD",   MOD     },
  805.     {"ODD",   ODD     },
  806.     {"CAP",   CAP     },
  807.     {"ORD",   ORD     },
  808.     {"VAL",   VAL     },
  809.     {"EXCL",  EXCL     },
  810.     {"HIGH",  HIGH       },
  811.     {"INCL",  INCL     },
  812.     {"SIZE",  SIZE       },
  813.     {"FLOAT", FLOAT_FUNC },
  814.     {"TRUNC", TRUNC     },
  815. };
  816.  
  817.  
  818. /* Read one token, getting characters through lexptr.  */
  819.  
  820. /* This is where we will check to make sure that the language and the operators used are
  821.    compatible  */
  822.  
  823. static int
  824. yylex ()
  825. {
  826.   register int c;
  827.   register int namelen;
  828.   register int i;
  829.   register char *tokstart;
  830.   register char quote;
  831.  
  832.  retry:
  833.  
  834.   tokstart = lexptr;
  835.  
  836.  
  837.   /* See if it is a special token of length 2 */
  838.   for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
  839.      if(STREQN(tokentab2[i].name, tokstart, 2))
  840.      {
  841.     lexptr += 2;
  842.     return tokentab2[i].token;
  843.      }
  844.  
  845.   switch (c = *tokstart)
  846.     {
  847.     case 0:
  848.       return 0;
  849.  
  850.     case ' ':
  851.     case '\t':
  852.     case '\n':
  853.       lexptr++;
  854.       goto retry;
  855.  
  856.     case '(':
  857.       paren_depth++;
  858.       lexptr++;
  859.       return c;
  860.  
  861.     case ')':
  862.       if (paren_depth == 0)
  863.     return 0;
  864.       paren_depth--;
  865.       lexptr++;
  866.       return c;
  867.  
  868.     case ',':
  869.       if (comma_terminates && paren_depth == 0)
  870.     return 0;
  871.       lexptr++;
  872.       return c;
  873.  
  874.     case '.':
  875.       /* Might be a floating point number.  */
  876.       if (lexptr[1] >= '0' && lexptr[1] <= '9')
  877.     break;            /* Falls into number code.  */
  878.       else
  879.       {
  880.      lexptr++;
  881.      return DOT;
  882.       }
  883.  
  884. /* These are character tokens that appear as-is in the YACC grammar */
  885.     case '+':
  886.     case '-':
  887.     case '*':
  888.     case '/':
  889.     case '^':
  890.     case '<':
  891.     case '>':
  892.     case '[':
  893.     case ']':
  894.     case '=':
  895.     case '{':
  896.     case '}':
  897.     case '#':
  898.     case '@':
  899.     case '~':
  900.     case '&':
  901.       lexptr++;
  902.       return c;
  903.  
  904.     case '\'' :
  905.     case '"':
  906.       quote = c;
  907.       for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
  908.     if (c == '\\')
  909.       {
  910.         c = tokstart[++namelen];
  911.         if (c >= '0' && c <= '9')
  912.           {
  913.         c = tokstart[++namelen];
  914.         if (c >= '0' && c <= '9')
  915.           c = tokstart[++namelen];
  916.           }
  917.       }
  918.       if(c != quote)
  919.      error("Unterminated string or character constant.");
  920.       yylval.sval.ptr = tokstart + 1;
  921.       yylval.sval.length = namelen - 1;
  922.       lexptr += namelen + 1;
  923.  
  924.       if(namelen == 2)      /* Single character */
  925.       {
  926.        yylval.ulval = tokstart[1];
  927.        return CHAR;
  928.       }
  929.       else
  930.      return STRING;
  931.     }
  932.  
  933.   /* Is it a number?  */
  934.   /* Note:  We have already dealt with the case of the token '.'.
  935.      See case '.' above.  */
  936.   if ((c >= '0' && c <= '9'))
  937.     {
  938.       /* It's a number.  */
  939.       int got_dot = 0, got_e = 0;
  940.       register char *p = tokstart;
  941.       int toktype;
  942.  
  943.       for (++p ;; ++p)
  944.     {
  945.       if (!got_e && (*p == 'e' || *p == 'E'))
  946.         got_dot = got_e = 1;
  947.       else if (!got_dot && *p == '.')
  948.         got_dot = 1;
  949.       else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
  950.            && (*p == '-' || *p == '+'))
  951.         /* This is the sign of the exponent, not the end of the
  952.            number.  */
  953.         continue;
  954.       else if ((*p < '0' || *p > '9') &&
  955.            (*p < 'A' || *p > 'F') &&
  956.            (*p != 'H'))  /* Modula-2 hexadecimal number */
  957.         break;
  958.     }
  959.     toktype = parse_number (p - tokstart);
  960.         if (toktype == ERROR)
  961.       {
  962.         char *err_copy = (char *) alloca (p - tokstart + 1);
  963.  
  964.         memcpy (err_copy, tokstart, p - tokstart);
  965.         err_copy[p - tokstart] = 0;
  966.         error ("Invalid number \"%s\".", err_copy);
  967.       }
  968.     lexptr = p;
  969.     return toktype;
  970.     }
  971.  
  972.   if (!(c == '_' || c == '$'
  973.     || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
  974.     /* We must have come across a bad character (e.g. ';').  */
  975.     error ("Invalid character '%c' in expression.", c);
  976.  
  977.   /* It's a name.  See how long it is.  */
  978.   namelen = 0;
  979.   for (c = tokstart[namelen];
  980.        (c == '_' || c == '$' || (c >= '0' && c <= '9')
  981.     || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
  982.        c = tokstart[++namelen])
  983.     ;
  984.  
  985.   /* The token "if" terminates the expression and is NOT
  986.      removed from the input stream.  */
  987.   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
  988.     {
  989.       return 0;
  990.     }
  991.  
  992.   lexptr += namelen;
  993.  
  994.   /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
  995.      and $$digits (equivalent to $<-digits> if you could type that).
  996.      Make token type LAST, and put the number (the digits) in yylval.  */
  997.  
  998.   if (*tokstart == '$')
  999.     {
  1000.       register int negate = 0;
  1001.       c = 1;
  1002.       /* Double dollar means negate the number and add -1 as well.
  1003.      Thus $$ alone means -1.  */
  1004.       if (namelen >= 2 && tokstart[1] == '$')
  1005.     {
  1006.       negate = 1;
  1007.       c = 2;
  1008.     }
  1009.       if (c == namelen)
  1010.     {
  1011.       /* Just dollars (one or two) */
  1012.       yylval.lval = - negate;
  1013.       return LAST;
  1014.     }
  1015.       /* Is the rest of the token digits?  */
  1016.       for (; c < namelen; c++)
  1017.     if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
  1018.       break;
  1019.       if (c == namelen)
  1020.     {
  1021.       yylval.lval = atoi (tokstart + 1 + negate);
  1022.       if (negate)
  1023.         yylval.lval = - yylval.lval;
  1024.       return LAST;
  1025.     }
  1026.     }
  1027.  
  1028.   /* Handle tokens that refer to machine registers:
  1029.      $ followed by a register name.  */
  1030.  
  1031.   if (*tokstart == '$') {
  1032.     for (c = 0; c < NUM_REGS; c++)
  1033.       if (namelen - 1 == strlen (reg_names[c])
  1034.       && STREQN (tokstart + 1, reg_names[c], namelen - 1))
  1035.     {
  1036.       yylval.lval = c;
  1037.       return REGNAME;
  1038.     }
  1039.     for (c = 0; c < num_std_regs; c++)
  1040.      if (namelen - 1 == strlen (std_regs[c].name)
  1041.      && STREQN (tokstart + 1, std_regs[c].name, namelen - 1))
  1042.        {
  1043.      yylval.lval = std_regs[c].regnum;
  1044.      return REGNAME;
  1045.        }
  1046.   }
  1047.  
  1048.  
  1049.   /*  Lookup special keywords */
  1050.   for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
  1051.      if(namelen == strlen(keytab[i].keyw) && STREQN(tokstart,keytab[i].keyw,namelen))
  1052.        return keytab[i].token;
  1053.  
  1054.   yylval.sval.ptr = tokstart;
  1055.   yylval.sval.length = namelen;
  1056.  
  1057.   /* Any other names starting in $ are debugger internal variables.  */
  1058.  
  1059.   if (*tokstart == '$')
  1060.     {
  1061.       yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
  1062.       return INTERNAL_VAR;
  1063.     }
  1064.  
  1065.  
  1066.   /* Use token-type BLOCKNAME for symbols that happen to be defined as
  1067.      functions.  If this is not so, then ...
  1068.      Use token-type TYPENAME for symbols that happen to be defined
  1069.      currently as names of types; NAME for other symbols.
  1070.      The caller is not constrained to care about the distinction.  */
  1071.  {
  1072.  
  1073.  
  1074.     char *tmp = copy_name (yylval.sval);
  1075.     struct symbol *sym;
  1076.  
  1077.     if (lookup_partial_symtab (tmp))
  1078.       return BLOCKNAME;
  1079.     sym = lookup_symbol (tmp, expression_context_block,
  1080.              VAR_NAMESPACE, 0, NULL);
  1081.     if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
  1082.       return BLOCKNAME;
  1083.     if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
  1084.       return TYPENAME;
  1085.  
  1086.     if(sym)
  1087.     {
  1088.        switch(sym->class)
  1089.        {
  1090.        case LOC_STATIC:
  1091.        case LOC_REGISTER:
  1092.        case LOC_ARG:
  1093.        case LOC_REF_ARG:
  1094.        case LOC_REGPARM:
  1095.        case LOC_REGPARM_ADDR:
  1096.        case LOC_LOCAL:
  1097.        case LOC_LOCAL_ARG:
  1098.        case LOC_BASEREG:
  1099.        case LOC_BASEREG_ARG:
  1100.        case LOC_CONST:
  1101.        case LOC_CONST_BYTES:
  1102.        case LOC_OPTIMIZED_OUT:
  1103.       return NAME;
  1104.  
  1105.        case LOC_TYPEDEF:
  1106.       return TYPENAME;
  1107.  
  1108.        case LOC_BLOCK:
  1109.       return BLOCKNAME;
  1110.  
  1111.        case LOC_UNDEF:
  1112.       error("internal:  Undefined class in m2lex()");
  1113.  
  1114.        case LOC_LABEL:
  1115.       error("internal:  Unforseen case in m2lex()");
  1116.        }
  1117.     }
  1118.     else
  1119.     {
  1120.        /* Built-in BOOLEAN type.  This is sort of a hack. */
  1121.        if(STREQN(tokstart,"TRUE",4))
  1122.        {
  1123.       yylval.ulval = 1;
  1124.       return M2_TRUE;
  1125.        }
  1126.        else if(STREQN(tokstart,"FALSE",5))
  1127.        {
  1128.       yylval.ulval = 0;
  1129.       return M2_FALSE;
  1130.        }
  1131.     }
  1132.  
  1133.     /* Must be another type of name... */
  1134.     return NAME;
  1135.  }
  1136. }
  1137.  
  1138. #if 0        /* Unused */
  1139. static char *
  1140. make_qualname(mod,ident)
  1141.    char *mod, *ident;
  1142. {
  1143.    char *new = malloc(strlen(mod)+strlen(ident)+2);
  1144.  
  1145.    strcpy(new,mod);
  1146.    strcat(new,".");
  1147.    strcat(new,ident);
  1148.    return new;
  1149. }
  1150. #endif  /* 0 */
  1151.  
  1152. void
  1153. yyerror(msg)
  1154.      char *msg;    /* unused */
  1155. {
  1156.    printf_unfiltered("Parsing:  %s\n",lexptr);
  1157.    if (yychar < 256)
  1158.      error("Invalid syntax in expression near character '%c'.",yychar);
  1159.    else
  1160.      error("Invalid syntax in expression");
  1161. }
  1162.  
  1163.